home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / fortran / toolpack.000 / toolpack / toolpack1.2 / tables / ZLLALL.MAC.f < prev    next >
Encoding:
Text File  |  1989-03-04  |  8.2 KB  |  344 lines
  1. C---------------------------------------------------------
  2. C    TOOLPACK/1    Release: 1.1
  3. C---------------------------------------------------------
  4. C
  5. C  ZLLAPP - 05 MAR 84
  6. C           TIE LIBRARY
  7. C           TABLES SUPPLEMENTARY LIBRARY
  8. C
  9. C  APPEND A NEW ELEMENT INTO A LINKED LIST AFTER THE CURRENT ELEMENT
  10. C  AND MAKE THE NEW ELEMENT THE CURRENT ELEMENT
  11. C
  12. C  THE VALUE OF THE FUNCTION IS EITHER 'ERR' OR 'NOERR'.
  13. C
  14.       INTEGER FUNCTION ZLLAPP(VALUES, ARRAY)
  15.  
  16.       INTEGER FREPNT, STEP, I, POINT
  17.       INTEGER VALUES(*), ARRAY(*)
  18.  
  19. C  CHECK LEGALITY OF REQUEST
  20.       ZLLAPP = -1
  21.       IF(ARRAY(1) .NE. 108)  RETURN
  22.       ZLLAPP = -100
  23.       IF(ARRAY(8) - ARRAY(4) .EQ. 0) RETURN
  24.  
  25. C  LOOK FOR AN EMPTY ENTRY (NEGATIVE POINTERS).
  26.       STEP = ARRAY(3) + 2
  27.       DO 10 FREPNT = 9, ARRAY(2), STEP
  28.         IF((ARRAY(FREPNT) .EQ. -1) .AND.
  29.      +     (ARRAY(FREPNT+1) .EQ. -1)) GO TO 20
  30.    10 CONTINUE
  31.       RETURN
  32.  
  33. C  COPY THE VALUES INTO THE ENTRY
  34.    20 CONTINUE
  35.       DO 30 I = 1, ARRAY(3)
  36.         ARRAY(FREPNT + 1 + I) = VALUES(I)
  37.    30 CONTINUE
  38.  
  39. C  UPDATE THE POINTERS, THERE IS A DIFFERENT TECHNIQUE IF THE LIST
  40. C  IS CURRENTLY EMPTY
  41.  
  42.       IF(ARRAY(4) .EQ. 0) THEN
  43.         ARRAY(7)          = FREPNT
  44.         ARRAY(FREPNT)     = FREPNT
  45.         ARRAY(FREPNT + 1) = FREPNT
  46.  
  47.       ELSE
  48.         POINT = ARRAY(6)
  49.         ARRAY(FREPNT)            = POINT
  50.         ARRAY(FREPNT + 1)        = ARRAY(POINT + 1)
  51.         ARRAY(ARRAY(POINT + 1))  = FREPNT
  52.         ARRAY(POINT + 1)         = FREPNT
  53.  
  54.       ENDIF
  55.  
  56.       ARRAY(4) = ARRAY(4) + 1
  57.       ARRAY(5) = ARRAY(5) + 1
  58.       ARRAY(6) = FREPNT
  59.  
  60.       ZLLAPP = -2
  61.  
  62.       RETURN
  63.       END
  64. C----------------------------------------------------------------------
  65. C
  66. C  ZLLCHG - 05 MAR 84
  67. C           TIE LIBRARY
  68. C           TABLES SUPPLEMENTARY LIBRARY
  69. C
  70. C  CHANGE THE CONTENTS OF THE CURRENT ELEMENT
  71. C
  72. C  THE VALUE OF THE FUNCTION IS EITHER 'ERR' , 'EOF' OR THE ELEMENT NUMBER
  73. C
  74.       INTEGER FUNCTION ZLLCHG(VALUES, ARRAY)
  75.  
  76.       INTEGER I
  77.       INTEGER VALUES(*), ARRAY(*)
  78.  
  79. C  CHECK LEGALITY OF REQUEST
  80.       ZLLCHG = -1
  81.       IF(ARRAY(1) .NE. 108)  RETURN
  82.       IF(ARRAY(4) .EQ. 0)     RETURN
  83.  
  84. C  UPDATE THE LIST ELEMENT VALUES
  85.       DO 10 I = 1, ARRAY(3)
  86.         ARRAY(ARRAY(6) + 1 + I) = VALUES(I)
  87.    10 CONTINUE
  88.  
  89.       ZLLCHG = -2
  90.  
  91.       RETURN
  92.       END
  93. C----------------------------------------------------------------------
  94. C
  95. C  ZLLDEL - 05 MAR 84
  96. C           TIE LIBRARY
  97. C           TABLES SUPPLEMENTARY LIBRARY
  98. C
  99. C  DELETE THE CURRENT ELEMENT FROM THE LIST AND MAKE THE PREVIOUS ELEMENT
  100. C  THE CURRENT ELEMENT
  101. C
  102. C  THE VALUE OF THE FUNCTION IS EITHER 'ERR', 'EOF' OR 'NOERR'.
  103. C
  104.       INTEGER FUNCTION ZLLDEL(ARRAY)
  105.  
  106.       INTEGER POINT, FPOINT, BPOINT
  107.       INTEGER ARRAY(*)
  108.  
  109. C  CHECK LEGALITY OF REQUEST
  110.       ZLLDEL = -1
  111.       IF(ARRAY(1) .NE. 108)  RETURN
  112.       ZLLDEL = -100
  113.       IF(ARRAY(4) .EQ. 0) RETURN
  114.  
  115. C SAVE THE POINTERS AND SET THE ELEMENT TO 'EMPTY'
  116.       POINT  = ARRAY(6)
  117.       FPOINT = ARRAY(POINT + 1)
  118.       BPOINT = ARRAY(POINT)
  119.       ARRAY(POINT)     = -1
  120.       ARRAY(POINT + 1) = -1
  121.  
  122. C  UPDATE THE OTHER LIST POINTERS, THERE IS A DIFFERENT ACTION
  123. C  IF THIS IS THE ONLY ELEMENT
  124.       IF(ARRAY(4) .EQ. 1) THEN
  125.         ARRAY(5) = 0
  126.         ARRAY(6) = 0
  127.         ARRAY(7) = 0
  128.  
  129.       ELSE
  130.         IF(POINT .EQ. ARRAY(7)) ARRAY(7) = ARRAY(POINT)
  131.         ARRAY(BPOINT + 1) = FPOINT
  132.         ARRAY(FPOINT)     = BPOINT
  133.         ARRAY(6)          = BPOINT
  134.  
  135.       ENDIF
  136.  
  137.  
  138.       ARRAY(4) = ARRAY(4) - 1
  139.       IF(ARRAY(4) .NE. 0) ZLLDEL = -2
  140.       ARRAY(5) = ARRAY(5) - 1
  141.       IF(ARRAY(5) .LE. 0) ARRAY(5) = ARRAY(4)
  142.  
  143.       RETURN
  144.       END
  145. C----------------------------------------------------------------------
  146. C
  147. C  ZLLINT - 05 MAR 84
  148. C           TIE LIBRARY
  149. C           TABLES SUPPLEMENTARY LIBRARY
  150. C
  151. C  INITIALISE AN ARRAY AS A LINKED LIST
  152. C
  153. C  THE VALUE OF THE FUNCTION IS EITHER 'ERR' (THE SIZE OF THE ARRAY
  154. C  OR SPECIFIED WIDTH IS WRONG) OR 'NOERR'. THERE IS
  155. C  AN OVERHEAD OF 8 LOCATIONS RESERVED BY THE ROUTINES. NOT ALL THE
  156. C  RESERVED LOCATIONS ARE USED AT PRESENT.
  157. C  AN ADDITIONAL OVERHEAD OF 2 LOCATIONS PER LIST ENTRY IS USED TO
  158. C  RETAIN THE BAC AND FORWARD POINTERS RESPECTIVELY POINTERS.
  159. C
  160.       INTEGER FUNCTION ZLLINT(ARRAY, SIZE, WIDTH)
  161.  
  162.       INTEGER SIZE, WIDTH, STEP, I
  163.       INTEGER ARRAY(*)
  164.  
  165.       ZLLINT = -1
  166.       IF(WIDTH .LT. 0)          RETURN
  167.       IF(SIZE  .LT. WIDTH + 10) RETURN
  168.  
  169. C  IDENTIFY THE ARRAY AS A TABLE
  170.       ARRAY(1) = 108
  171. C  THE SIZE OF THE ARRAY
  172.       ARRAY(2) = SIZE
  173. C  THE WIDTH OF EACH ELEMENT
  174.       ARRAY(3) = WIDTH
  175. C  THE NUMBER OF ENTRIES
  176.       ARRAY(4) = 0
  177. C  THE CURRENT ENTRY NUMBER
  178.       ARRAY(5) = 0
  179. C  THE CURRENT ENTRY POINTER
  180.       ARRAY(6) = 0
  181. C  THE START OF THE RING
  182.       ARRAY(7) = 0
  183. C  MAXIMUM NUMBER OF ENTRIES
  184.       ARRAY(8) = (ARRAY(2) - 8) / (WIDTH + 2)
  185.  
  186. C  CLEAR THE POINTERS
  187.       STEP = WIDTH + 2
  188.       DO 10 I = 9, SIZE, STEP
  189.         ARRAY(I)     = -1
  190.         ARRAY(I + 1) = -1
  191.    10 CONTINUE
  192.  
  193.       ZLLINT = -2
  194.  
  195.       RETURN
  196.       END
  197. C----------------------------------------------------------------------
  198. C
  199. C  ZLLMOV - 05 MAR 84
  200. C           TIE LIBRARY
  201. C           TABLES SUPPLEMENTARY LIBRARY
  202. C
  203. C  MOVE TO A RELATIVE ELEMENT AS IF THIS WERE A RING LIST
  204. C
  205. C  THE VALUE OF THE FUNCTION IS EITHER 'ERR' OR THE ELEMENT NUMBER
  206. C
  207.       INTEGER FUNCTION ZLLMOV(MOVE, VALUES, ARRAY)
  208.  
  209.       INTEGER I, STEP, MOVE
  210.       INTEGER VALUES(*), ARRAY(*)
  211.       LOGICAL DIR
  212.  
  213.       ZLLMOV = -1
  214.       IF(ARRAY(1) .NE. 108)  RETURN
  215.       IF(ARRAY(4) .EQ. 0)     RETURN
  216.  
  217.       STEP = MOVE
  218.       DIR = .TRUE.
  219.       IF(MOVE .LT. 0) THEN
  220.         DIR  = .FALSE.
  221.         STEP = - MOVE
  222.       ENDIF
  223.       STEP = MOD(STEP, ARRAY(4))
  224.  
  225.       IF(STEP .GT. 0) THEN
  226.         IF(DIR) THEN
  227.           DO 20 I = 1, STEP
  228.             ARRAY(5) = ARRAY(5) + 1
  229.             IF(ARRAY(5) .GT. ARRAY(4)) ARRAY(5) = 1
  230.             ARRAY(6) = ARRAY(ARRAY(6) + 1)
  231.    20     CONTINUE
  232.  
  233.         ELSE
  234.           DO 30 I = 1, STEP
  235.             ARRAY(5) = ARRAY(5) - 1
  236.             IF(ARRAY(5) .LE. 0) ARRAY(5) = ARRAY(4)
  237.             ARRAY(6) = ARRAY(ARRAY(6))
  238.    30     CONTINUE
  239.  
  240.         ENDIF
  241.       ENDIF
  242.  
  243.       DO 10 I = 1, ARRAY(3)
  244.         VALUES(I) = ARRAY(ARRAY(6) + 1 + I)
  245.    10 CONTINUE
  246.  
  247.       ZLLMOV = ARRAY(5)
  248.  
  249.       RETURN
  250.       END
  251. C----------------------------------------------------------------------
  252. C
  253. C  ZLLNXT - 05 MAR 84
  254. C           TIE LIBRARY
  255. C           TABLES SUPPLEMENTARY LIBRARY
  256. C
  257. C  GO TO THE NEXT ELEMENT AS IF THIS WERE A LINEAR LIST
  258. C
  259. C  THE VALUE OF THE FUNCTION IS EITHER 'ERR' , 'EOF' OR THE ELEMENT NUMBER
  260. C
  261.       INTEGER FUNCTION ZLLNXT(VALUES, ARRAY)
  262.  
  263.       INTEGER I
  264.       INTEGER VALUES(*), ARRAY(*)
  265.  
  266.       ZLLNXT = -1
  267.       IF(ARRAY(1) .NE. 108)  RETURN
  268.       ZLLNXT = -100
  269.       IF(ARRAY(4) .EQ. 0)     RETURN
  270.       IF(ARRAY(5) .GE. ARRAY(4)) RETURN
  271.  
  272.       ARRAY(6) = ARRAY(ARRAY(6) + 1)
  273.       DO 10 I = 1, ARRAY(3)
  274.         VALUES(I) = ARRAY(ARRAY(6) + 1 + I)
  275.    10 CONTINUE
  276.  
  277.       ARRAY(5) = ARRAY(5) + 1
  278.       ZLLNXT = ARRAY(5)
  279.  
  280.       RETURN
  281.       END
  282. C----------------------------------------------------------------------
  283. C
  284. C  ZLLPRE - 05 MAR 84
  285. C           TIE LIBRARY
  286. C           TABLES SUPPLEMENTARY LIBRARY
  287. C
  288. C  GO TO THE PREVIOUS ELEMENT AS IF THIS WERE A LINEAR LIST
  289. C
  290. C  THE VALUE OF THE FUNCTION IS EITHER 'ERR' , 'EOF' OR THE ELEMENT NUMBER
  291. C
  292.       INTEGER FUNCTION ZLLPRE(VALUES, ARRAY)
  293.  
  294.       INTEGER I
  295.       INTEGER VALUES(*), ARRAY(*)
  296.  
  297.       ZLLPRE = -1
  298.       IF(ARRAY(1) .NE. 108)  RETURN
  299.       ZLLPRE = -100
  300.       IF(ARRAY(4) .LE. 1) RETURN
  301.  
  302.       ARRAY(6) = ARRAY(ARRAY(6))
  303.       DO 10 I = 1, ARRAY(3)
  304.         VALUES(I) = ARRAY(ARRAY(6) + 1 + I)
  305.    10 CONTINUE
  306.  
  307.       ARRAY(5) = ARRAY(5) - 1
  308.       ZLLPRE   = ARRAY(5)
  309.  
  310.       RETURN
  311.       END
  312. C----------------------------------------------------------------------
  313. C
  314. C  ZLLTYP - 05 MAR 84
  315. C           TIE LIBRARY
  316. C           TABLES SUPPLEMENTARY LIBRARY
  317. C
  318. C  RETURN INFORMATION ABOUT AN INITIALISED LINKED LIST
  319. C
  320. C  THE VALUE OF THE FUNCTION IS EITHER 'ERR' OR 'NOERR'.
  321. C
  322.       INTEGER FUNCTION ZLLTYP(ARRAY, WIDTH, CURNO, ENTRYS, FREE)
  323.  
  324.       INTEGER ENTRYS, FREE, CURNO, WIDTH
  325.       INTEGER ARRAY(*)
  326.  
  327.       ZLLTYP = -1
  328.       IF(ARRAY(1) .NE. 108)  RETURN
  329.  
  330. C  THE WIDTH OF EACH ELEMENT
  331.       WIDTH = ARRAY(3)
  332.  
  333. C  THE NUMBER OF ENTRIES
  334.       ENTRYS = ARRAY(4)
  335.       FREE   = ARRAY(8) - ENTRYS
  336.  
  337. C  THE CURRENT ENTRY NUMBER
  338.       CURNO = ARRAY(5)
  339.  
  340.       ZLLTYP = -2
  341.  
  342.       RETURN
  343.       END
  344.